module japiph;
import StdEnv, Scanner;

/* This program was based on a method for metaprogramming
advanced by Dr. Merten Joost. The idea is to write a
program that writes programs in C for us. Dr. Joost uses
C for this kind of application. However, you will see that
Clean is much safer and more productive for this kind of 
job. BTW, the Clean program is longer than the equivalent 
written in C, but the only reason for this is that I
added a lot of checks and comments in the Clean source, 
to make the application safer and easier to understand. */


Start world
   # (ok, jcfile, world)= fopen "jc.txt" FReadText world;
   | not ok= abort "I cannot open the jc.txt file.";
   # (ok, jph, world)= fopen "japi_p.h" FWriteText world;
     (jcfile, jph)= header jcfile jph; 
   #  (ok, world)= fclose jcfile world;
   # jph= fwrites "\n\n" jph;
     jph= fwrites "\n\n#endif\n" jph;
     (ok, world)= fclose jph world;
   = world;

header inFile f
  # f= fwrites "#ifdef JAPI_P_H\n#else\n" f;
    f= fwrites "  #define JAPI_P_H\n\n\n" f;
    (inFile, f)= findtype inFile f;
    (inFile, f)= body inFile f;
  = (inFile, f);


// NB: The first argument of 'words' is not a regular
// expression; it is a list of separators, like ['.,?'].
// If you prefer regular expressions, use tokens.
// Help is provided as comments in the Scanner library.
parseLine s= words [] s; 

findtype inFile f
   # (ok, inFile)= fend inFile;
   | ok = abort "File does not match specifications.";
   # (s, inFile)= freadline inFile;
   # xs= parseLine s;
   # (ok, jp, n)= notType xs;
   | ok= abort "File does not match specifications.";
   # num= (pad 40 ' ' jp)+++n+++"\n";
   # f= fwrites ("  #define "+++jp+++num) f;
   = (inFile, f);
where {
  notType ["TYPE", jp, num]
    | isToken ['[0-9]@+'] num= (False, jp, num);
  notType xs= (True, "",  "");
}

body inFile f
  # (ok, inFile)= fend inFile;
  | ok = (inFile, f);
  # (s, inFile)= freadline inFile;
    xs= parseLine s;
  | notCommandGroup xs= body inFile f;
  # (cmd, name, n)= getNumber xs;
    num= (pad 40 ' ' name)+++(toString n);
    def= "\n\n  #define "+++name+++num+++"\n";
    f= fwrites def f; 
    (inFile, f)= loop (n+1) inFile f;
  = body inFile f;
where {
  notCommandGroup ["CMDGROUP", name, num]
    | isToken ['[0-9]@+'] num= False;
  notCommandGroup xs= True;
  getNumber [cmd, name, num]= (cmd, name, toInt num);
  getNumber xs= abort "File does not match format.\n";
    
  loop n inFile f
     # (ok, inFile)= fend inFile;
     | ok= abort "File does not match format.\n";
     # (s, inFile)= freadline inFile;
       xs= parseLine s;
       tk= isCall xs;
     | tk == "END"= (inFile, f);    
    // # (ok, tk)= isCall xs;
    // | not ok= abort "Token does not match format.\n";
     # num= (pad 40 ' ' tk)+++(toString n)+++"\n";
       def= "  #define "+++tk+++num;
       f= fwrites def f; 
     = loop (n+1) inFile f;
  
  isCall [x] = x;
  //  | isToken ['JAPI_[A-Z]@+'] x= (True, x);
  isCall xs=  "";
}

prototypes inFile f
  # (ok, inFile)= fend inFile;
  | ok = (inFile, f);
  # (s, inFile)= freadline inFile;
    xs= parse_C s;
  | notProto xs= prototypes inFile f;
  # f= prt xs f;
  = prototypes inFile f;
where {
  notProto [tp, "japi", "_", nm:xs] = False;
  notProto xs= True;
  
  seps= ['();,}_{'];
  
  parse_C s= words seps  s; 
  
  prt [tp, jp, "_":xs] f
    # f= fwrites "extern " f;
      f= prt_type tp "" " " f;
      f= fwrites (jp+++"_") f;
    = loop xs f;
  prt xs f= f;
    
  prt_type tp x sp f
    | tp== "string" = fwrites ("char *"+++" "+++sp) f;
    | tp== "int" = fwrites ("int"+++" "+++sp) f;
    | tp== "CleanString" = fwrites (tp+++" "+++sp) f;
    | tp== "retstr" = fwrites ("char *"+++sp) f;
    | tp== "varintarr" = fwrites ("int *"+++sp) f;
    | tp== "intarr" = fwrites ("int *"+++sp) f;
    | tp== "varint"  = fwrites ("int *"+++sp) f;
    | tp== "char"    = fwrites ("char"+++sp) f;
    | tp== "bool"    = fwrites ("int"+++sp) f; 
    = fwrites (tp+++x+++sp) f;
  
  loop [] f
    # f= fwrites ";\n" f;
    = f;
  loop ["(", ")":xs] f
    # f= fwrites "()" f;
    =loop xs f;
  loop [tp, x, ",":xs] f 
         # f= prt_type tp x ", " f;
         = loop xs f;
  loop [tp, x, ")":xs] f 
         # f= prt_type tp x ")" f;
         = loop xs f;
  loop [x:xs] f
    # f= fwrites x f;
    = loop xs f;
}

